home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0091_Shading.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-27  |  1KB  |  90 lines
  1.  
  2. Program Shading;
  3.  
  4. Uses CRT;
  5.  
  6. Var
  7.   ColorNum, Y : Integer;
  8.  
  9. {--------------------------------------------------------------}
  10.  
  11. procedure setcolors;
  12.  
  13. var
  14.   Color : Byte;
  15.   A     : Integer;
  16.  
  17. Begin
  18.    For A := 1 to 63 do
  19.    Begin
  20.     port[$3c8]:=A;
  21.     port[$3c9]:=1;
  22.     port[$3c9]:=1;
  23.     port[$3c9]:=A;
  24.    End;
  25. end;
  26.  
  27. {----------------------------------------------------------------}
  28.  
  29. procedure horizontal_line (x1,x2,y : integer;color:byte);
  30.  
  31. Var
  32. temp,Counter : Integer;
  33.  
  34. begin
  35. IF X1 > X2 then
  36.   begin
  37.     Temp:=X1;
  38.     X1:=X2;
  39.     X2:=Temp;
  40.   End;
  41.  
  42.      X1:=(y*320)+X1;
  43.      X2:=(y*320)+X2;
  44.  
  45.  For Counter := X1 to X2 do
  46.  
  47.      mem[$A000:Counter]:=color;
  48. End;
  49. {---------------------------------------------------------------}
  50. Procedure Init13h;    {Sets video to 320X200X256}
  51.  
  52. Begin
  53.  
  54. ASM
  55.  MOV AH,00
  56.  MOV AL,13h
  57.  int 10h
  58. End;
  59. End;
  60. {----------------------------------------------------------------}
  61. Procedure InitText;   {Sets video to Textmode}
  62.  
  63. Begin
  64.  
  65. ASM
  66.  MOV AH,00
  67.  MOV AL,3
  68.  INT 10h
  69. End;
  70. End;
  71. {--------------------------------------------------------------------------}
  72.  
  73. Begin    {Main}
  74. ColorNum:=1;
  75. init13h;
  76. Setcolors;
  77. For Y:=1 to 63 do
  78.   Begin
  79.    Horizontal_Line(80,239,Y,Colornum);
  80.    ColorNum:=Colornum+1;
  81.   End;
  82. For Y:=64 to 126 do
  83.   Begin
  84.    ColorNum:=ColorNum-1;
  85.    Horizontal_Line(80,239,Y,ColorNum);
  86.   End;
  87. Readkey;
  88. InitText;
  89. End.
  90.